{-# LANGUAGE CPP, OverlappingInstances, FlexibleContexts, FlexibleInstances, UndecidableInstances, ScopedTypeVariables, NoMonomorphismRestriction #-}

module Sim.Loader.Parser (
   parseConfigFile, get,
   parseTableFile, parseArrayFile,
   parseFuncFile,
   parseGrismOrderFile,
   parsePsfArrayFile, parsePsfDataFile,
   parseDistortionArrayFile,
   parseAtlasSpectralTypesFile,
   parseObjectsFile
 ) where


import Control.Monad.Reader
import Control.Monad.Error
import Control.Monad.List

import Data.Either
import Data.Typeable                ( Typeable, typeOf )
import Data.Array.Unboxed           ( UArray, array, (!), bounds )
import Data.ConfigFile              ( emptyCP, readfile, ConfigParser(..), CPErrorData(..), CPError,  SectionSpec, OptionSpec )
import Data.VectorSpace             ( (^*), (^/) )

import Text.Printf                  ( printf )
import Text.ParserCombinators.Table

import Sim.Loader.Parser.Error
import Sim.Helper                   ( pair,  )
import Sim.Star                     ( Star (..) )
import Sim.PhysTypes                ( FiledView, SpType )

import qualified Data.Map                               as M
import qualified Data.ConfigFile                        as CF
import qualified Interpolation                          as I
import qualified Text.ParserCombinators.TableWithConfig as T

class Get a where
   getValue :: MonadError CPError m => ConfigParser -> SectionSpec -> OptionSpec -> m a

   -- Извлекает информацию из строки в конфигурационном файле.
   -- Может применяться в парсере анализатора parseConfigFile.
   get :: (Show a, MonadReader (ConfigParser, FilePath) m, MonadError SCPError m, MonadIO m) => SectionSpec -> OptionSpec -> m a
   get s o = do
     cp <- asks $ fst
     fn <- asks $ snd

#ifdef DEBUG
     liftIO $ printf "%20s : %23s = " s o
#endif

     v <- either (throwError . CPError fn) (return) $ getValue cp s o

#ifdef DEBUG
     liftIO $ printf "%s\n" (show v)
#endif

     return v

instance Get String where
   getValue = CF.get

instance (Read a, Typeable a) => Get a where
   getValue = getGeneric undefined where

      getGeneric :: (Read a, Typeable a, MonadError CPError m) => a -> ConfigParser -> SectionSpec -> OptionSpec -> m a
      getGeneric r cp s o = do

         val <- getValue cp s o

         case reads val of
             (v,""):_ -> return v
             _        -> throwError ( ParseError $ "couldn't parse type " ++ (show $ typeOf r) ++ " " ++ val ++ " from " ++ "(" ++ s ++ "/" ++ o ++ ")", "get")

-- Анализатор файла конфигурации. Файл конфигурации - это  INI-подобный файл,
-- но с некоторым количеством улучшений.
parseConfigFile :: (MonadError SCPError m, MonadIO m) => FilePath -> ReaderT (ConfigParser, FilePath) m a -> m a
parseConfigFile fn p = do
   let cp = emptyCP {optionxform = map id}
   cp <- join $ liftIO $ readfile cp fn >>= return . either (throwError . CPError fn) (return)
   runReaderT p (cp,fn)

-- Анализатор файла с данными представленными в виде таблицы, в котором имеется
-- описательная (конфигурационная) часть, расположенная перед таблицей.
parseTableFile contentParser postParser fname = do
   s <- liftIO $ readFile fname
   let m = T.readTableWithConfig s contentParser >>= postParser
   either (throwError.TPError fname) (return) m

-- Анализатор, построенный на основе parseTableFile. Извлекает информацию
-- из файла и преобразует ее в 2-ух мерный массив. Количество элементов
-- массива определяется в конфигурационной части анализируемого файла.
parseArrayFile contentParser = parseTableFile contentParser postParser
   where
      postParser (cp,t) = do
           (l,r) <- T.get cp "DEFAULT" "Bounds"

           case (indexS l r t) of
                 Just a  -> return $ array (l,r) a
                 Nothing -> throwError $ strMsg "It is epic fail!!!"
         where
            indexS :: (Int,Int) -> (Int,Int)-> [[a]] -> Maybe [((Int,Int),a)]
            indexS (l,l') (r,r') xs  = runListT $ do
                                                    (i, ys) <- ListT $ zipS [l .. r ] xs
                                                    (j,  x) <- ListT $ zipS [l'.. r'] ys
                                                    return ((i,j), x)

            zipS :: [a] -> [b] -> Maybe [(a,b)]
            zipS [] [] = Just []
            zipS (x:xs) (y:ys) = do
                                   r <- zipS xs ys
                                   return $ (x,y) : r
            zipS _ _ = Nothing

-- Анализатор, построенный на основе parseTableFile. Извлекает информацию из файла и
-- с помощью линейной интерполяции преобразует ее в функцию.  Границы области определения
-- и шаг семплирования определяется в конфигурационной части анализируемого файла.
parseFuncFile :: (MonadError SCPError m, MonadIO m) => FilePath -> m (Double -> Double)
parseFuncFile = parseTableFile cParser pParser
   where
      cParser = lift $ return $ do
         x <- double
         y <- double
         return (x,y)
      pParser (cp, t) = do
         b <- T.get cp "DEFAULT" "Bounds"
         h <- T.get cp "DEFAULT" "Step"
         return $ I.linearSampling b h t

-- 
-- 
-- 
parseGrismOrderFile :: (MonadError SCPError m, MonadIO m) => FilePath -> m [(Double, (Double,Double), Double)]
parseGrismOrderFile = parseTableFile cParser pParser
   where
      cParser = lift $ return $ do
         i <- double
         x <- double
         y <- double
         l <- double
         return (i, (x,y), l)

      pParser (cp, t) = return t

-- Анализатор, построенный на основе parseArrayFile. Используется для анализа
-- файла, в котором содержится в виде таблицы значения ФРТ для конкретной точки
-- фокальной плоскости.
parsePsfArrayFile :: (MonadError SCPError m, MonadIO m) => FilePath -> m (UArray (Int, Int) Double)
parsePsfArrayFile = parseArrayFile cParser
   where
      cParser = do
         cp <- ask
         lift $ do
           (l,r) :: ((Int,Int),(Int,Int)) <- T.get cp "DEFAULT" "Bounds"
           let n = 1 + snd r - snd l
           return $ replicateM n double

-- Анализатор, построенный на основе parsePsfArrayFile. Используется для анализа файлов,
-- в которых содержится в виде таблицы значение ФРТ для конкретной точки.
parsePsfDataFile :: (MonadError SCPError m, MonadIO m) => FilePath -> m (((Int,Int), (Int,Int)), (Int, Int) -> Double)
parsePsfDataFile fname = do

  arr <- parsePsfArrayFile fname

  let b  = bounds arr
      bi = pair fst b
      bj = pair snd b

      f (i, j) = arr ! (index bi i, index bj j)
   
  return (b, f)

   where
      index (l,r) i | i < l = l
                    | i > r = r
                    | otherwise = i

-- Анализатор, построенный на основе parseTableFile. Используется для анализа файлов,
-- в которых содержится в виде таблицы карта дисторсии.
{--
parseDistortionArrayFile :: (MonadError SCPError m, MonadIO m) => FilePath -> m (Int -> Int -> (Double, Double))
parseDistortionArrayFile = parseTableFile cParser pParser
   where
      cParser = do
         cp <- ask
         lift $ do
           s  <- T.get cp "DEFAULT" "ScaleRatio"
           gs <- T.get cp "DEFAULT" "GridSize"
           let n = ( (fst gs) - 1 ) `div` 2
               m = ( (snd gs) - 1 ) `div` 2
           return $ do
                      i <- int
                      j <- int
                      replicateM 5 skip
                      x <- double
                      y <- double
                      return ((i+n,j+m), (x,y) ^* s)
      pParser (cp, t) = do
         {-
           DOTO: Делать проверку того, что список t  содержит нужное количество элементов для создания массива.
         -}

         (n,m) <- T.get cp "DEFAULT" "GridSize"
         let lb  = (0, 0)
             rb  = (n-1, m-1)
             arr = array (lb,rb) t
         return $ \u v -> arr ! (u `mod` n, v `mod` m)
--}
--{--
parseDistortionArrayFile :: (MonadError SCPError m, MonadIO m) => FilePath -> m [((Double,Double),(Double, Double))]
parseDistortionArrayFile = parseTableFile cParser pParser
   where
      cParser = do
         cp <- ask
         lift $ do
           s  <- T.get cp "DEFAULT" "ScaleRatio"
           return $ do
                      i <- int
                      j <- int
                      u <- double
                      v <- double
                      replicateM 3 skip
                      x <- double
                      y <- double
                      return ((u,v), (x,y) ^* s)
      pParser (cp, t) = return t
--}

--
parseAtlasSpectralTypesFile :: (MonadError SCPError m, MonadIO m) => FilePath -> m (FilePath, [(String, String)])
parseAtlasSpectralTypesFile = parseTableFile cParser pParser
   where
      cParser = do
         cp <- ask
         lift $ do
           p <- T.get cp "DEFAULT" "FilePath"
           return $ do
                      sp <- string
                      fn <- string
                      return (sp, p++fn)
      pParser (cp, t) = do
           fv <- T.get cp "DEFAULT" "FileVegaSED"

           return (fv,t)

--
parseObjectsFile :: (MonadError SCPError m, MonadIO m) => [(SpType,Double->Double)] -> FiledView -> FilePath -> m ([Star],FilePath)
parseObjectsFile sps fov fn = parseTableFile cParser pParser fn
   where
      msps = M.fromList sps

      cParser = do
         cp <- ask
         lift $ do
           return $ do
                      x  <- double
                      y  <- double
                      st <- string
                      m  <- double

                      return (st, m, (x,y)^/60)
      pParser (cp, sts) = do

         fl <- T.get cp "DEFAULT" "MagnitudeFilter"

         os <- forM sts $ \(st, m, xy) -> do

              case st `M.lookup` msps of
                   Nothing -> T.liftL $ throwError (OtherProblem $ "Used Spectral Types Atlas does not have " ++ st, "parseObjectsFile")
                   Just sp -> return $ Star sp st m xy
         return (os,fl)
